home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / compiler / Pr_zam.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  2.9 KB  |  107 lines  |  [TEXT/R*ch]
  1. local
  2.   open Obj Fnlib Config Mixture Const Instruct Asynt Pr_lam;
  3. in
  4.  
  5. (* 1996.07.05 -- e *)
  6.  
  7. val printZamInstr = fn
  8.     Kquote sc =>
  9.       printStrConst sc
  10.   | Kget_global (qualid, stamp) =>
  11.       (msgString "get_global "; printQualId qualid;
  12.        msgString "/"; msgInt stamp)
  13.   | Kset_global (qualid, stamp) =>
  14.       (msgString "set_global "; printQualId qualid;
  15.        msgString "/"; msgInt stamp)
  16.   | Kaccess i =>
  17.       (msgString "access "; msgInt i)
  18.   | Kenvacc i =>
  19.       (msgString "envacc "; msgInt i)
  20.   | Kassign i =>
  21.       (msgString "assign "; msgInt i)
  22.   | Kgetfield i =>
  23.       (msgString "getfield "; msgInt i)
  24.   | Ksetfield i =>
  25.       (msgString "setfield "; msgInt i)
  26.   | Kpush =>
  27.       msgString "push"
  28.   | Kpop i =>
  29.       (msgString "pop "; msgInt i)
  30.   | Krestart =>
  31.       msgString "restart"
  32.   | Kgrab i =>
  33.       (msgString "grab "; msgInt i)
  34.   | Kapply n =>
  35.       (msgString "apply "; msgInt n)
  36.   | Kappterm (n,z) =>
  37.       (msgString "appterm "; msgInt n; msgString " "; msgInt z)
  38.   | Kpush_retaddr i =>
  39.       (msgString "push_retaddr "; msgInt i)
  40.   | Kcheck_signals =>
  41.       msgString "check_signals"
  42.   | Kreturn i =>
  43.       (msgString "return "; msgInt i)
  44.   | Kclosure (i,n) =>
  45.       (msgString "closure "; msgInt i; msgString " "; msgInt n)
  46.   | Kclosurerec (i,n) =>
  47.       (msgString "closurerec "; msgInt i; msgString " "; msgInt n)
  48.   | Kraise =>
  49.       msgString "raise"
  50.   | Kmakeblock(ct, i) =>
  51.       (msgString "makeblock "; printCTag ct; msgString " "; msgInt i)
  52.   | Kprim prim =>
  53.       printPrim prim
  54.   | Kpushtrap i =>
  55.       (msgString "pushtrap "; msgInt i)
  56.   | Kpoptrap =>
  57.       msgString "poptrap"
  58.   | Klabel i =>
  59.       (msgString "label "; msgInt i)
  60.   | Kbranch i =>
  61.       (msgString "branch "; msgInt i)
  62.   | Kbranchif i =>
  63.       (msgString "branchif "; msgInt i)
  64.   | Kbranchifnot i =>
  65.       (msgString "branchifnot "; msgInt i)
  66.   | Kstrictbranchif i =>
  67.       (msgString "strictbranchif "; msgInt i)
  68.   | Kstrictbranchifnot i =>
  69.       (msgString "strictbranchifnot "; msgInt i)
  70.   | Ktest(tst, i) =>
  71.       (msgString "test:"; printBoolTest tst;
  72.        msgString " "; msgInt i)
  73.   | Kbranchinterval(i1, i2, i3, i4) =>
  74.       (msgString "branchinterval "; msgInt i1;
  75.        msgString " "; msgInt i2;
  76.        msgString " "; msgInt i3;
  77.        msgString " "; msgInt i4)
  78.   | Kswitch v =>
  79.       let val () = msgString "switch "
  80.           val len = Array.length v
  81.       in
  82.         for (fn i =>
  83.                (msgInt (Array.sub(v, i-1));
  84.                 if i < len then msgString " " else ()))
  85.             1 len
  86.       end
  87. ;
  88.  
  89. fun printZamSeq zams = printSeq printZamInstr "; " zams;
  90.  
  91. fun printZamPhrase
  92.         { kph_is_pure=is_pure, kph_inits=inits, kph_funcs=funcs } =
  93. (
  94.   msgIBlock 0;
  95.   msgString "***kph_is_pure*** = ";
  96.   msgString (if is_pure then "true;" else "false;");
  97.   msgEOL();
  98.   msgString "***kph_inits*** = ";
  99.   printSeq printZamInstr "; " inits;
  100.   msgEOL(); msgString "***kph_funcs*** = ";
  101.   printSeq printZamInstr "; " funcs;
  102.   msgEOL();
  103.   msgEBlock()
  104. );
  105.  
  106. end;
  107.